Developer CD Series 1998 May: Tool Chest/Dev.CD May 98 TC.toast/Tool Chest/Development Kits/HyperCard Related/APDA HyperCard Toolkits/HyperCard CTB Toolkit 1.0b2/Source Code/CTBEditUpTo.p

Text File | 1995-02-07 | 9.7 KB | 359 lines | [TEXT/MPS ]

(*
    CTBEditUpTo([termChar[,timeOut[,wrapCol[,limit]]]]) -- Receive characters until the termChar is
        received, or until timeOut 60ths of a second have passed. Echo incoming characters to the
        output, and allow editing. Wrap the input at wrapCol columns by inserting returns.

    Note: This XCMD assumes relatively small amounts of low bandwidth data. So it isn't real careful
    about time efficiency. It's primarily intended to allow the Mac to play the host side of a dial-in
    connection.

    To compile and link this file using Macintosh Programmer's Workshop,

        pascal -w CTBEditUpTo.p
        link -m ENTRYPOINT -o HyperCommands -rt XFCN=2763 -sn Main=CTBEditUpTo ∂
            CTBEditUpTo.p.o "{MPW}"Libraries:interface.o "{MPW}"Libraries:Libraries:HyperXLib.o

    © Copyright 1990 by Apple Computer, Inc.

    Initial coding 2/90 by Harry R. Chesley.
*)

{$R-}

{$S CTBEditUpTo }     { Segment name must be the same as the command name. }

unit DummyUnit;

interface

uses MemTypes, QuickDraw, OSIntf, ToolIntf, CTBUtils, FTIntf, CMIntf, TMIntf, CRMIntf, HyperXCmd;

procedure EntryPoint(paramPtr: XCmdPtr);

implementation

procedure CTBEditUpTo(paramPtr: XCmdPtr); forward;

procedure EntryPoint(paramPtr: XCmdPtr);

    begin
        CTBEditUpTo(paramPtr);
    end;

procedure CTBEditUpTo(paramPtr: XCmdPtr);

    {$I CTBUtil.inc}

    const return = 13;        { Carriage return. }
        linefeed = 10;            { Line feed. }
        backspace = 8;            { Back space. }
        delete = 127;            { Delete. }
        space = ord(' ');        { Space. }
        tab = 9;                    { Horizontal tab. }

    var lookForTerm: boolean;
        termString: Ptr;
        termPtr, oldTermPtr: Ptr;
        stopAt: longInt;
        timeOut: longInt;
        wrapCol: longInt;
        col: longInt;
        gotIt: boolean;
        toRead: longInt;
        toCopy: longInt;
        oldSize: longInt;
        l, l2: longInt;
        h: Handle;
        p: Ptr;
        sizes: CMBufferSizes;
        status: CMStatFlags;
        theBuf: InputBufferHandle;
        b: SignedByte;
        plusCount: integer;
        recvMax: longInt;

    procedure Fail(errMsg: Str255); { set theResult and quit }
        begin
            { If we had the termination string parameter locked down, unlock it. }
            if lookForTerm then HUnlock(paramPtr^.params[1]);
            paramPtr^.returnValue := PasToZero(paramPtr,errMsg);
            exit(CTBEditUpTo);
        end;

    procedure putByte(theByte: SignedByte);
        { Add a byte to the handle h. }

        var sz: longInt;
            p: Ptr;

        begin
            sz := GetHandleSize(h);
            SetHandleSize(h,sz+1);
            if MemError <> noErr then
                begin
                    DisposHandle(h);
                    Fail('Out of memory');
                end;
            p := Ptr(ord4(h^)+sz);
            p^ := theByte;
            recvMax := recvMax+1;
        end;

    function backspaceByte: SignedByte;
        { Backspace out a byte from the handle. }

        var sz: longInt;
            p: Ptr;

        begin
            sz := GetHandleSize(h);
            if sz > 0 then
                begin
                    p := Ptr(ord4(h^)+sz-1);
                    backspaceByte := p^;
                    SetHandleSize(h,sz-1);
                    recvMax := recvMax-1;
                end
            else backspaceByte := 0;
        end;

    procedure sendByte(theByte: SignedByte);
        { Send a byte to the connection, making sure we don't accidentally trip up a modem with "+++". }

        const plus = ord('+');

        var ioSize: longInt;
            b: array [1..1] of SignedByte;
            flags: integer;
            err: OSErr;

        begin
            { If we were supposed to send a plus previously, send it now with the next character. }
            if plusCount = 3 then
                begin
                    ioSize := 1;
                    b[1] := plus;
                    flags := cmFlagsEOM;
                    err := CMWrite(Globals^^.connHand,@b,ioSize,cmData,false,nil,-1,flags);
                    plusCount := 0;
                end
            { Otherwise, if we are now about to send a plus, increment the counts of pluses sent. }
            else if theByte = plus then plusCount := plusCount+1
            { Otherwise we're not sending a plus, so clear the plus count. }
            else plusCount := 0;
            { If we're not about to send the third plus (which might be a modem attention), then send it normally. }
            if plusCount <> 3 then
                begin
                    ioSize := 1;
                    b[1] := theByte;
                    flags := cmFlagsEOM;
                    err := CMWrite(Globals^^.connHand,@b,ioSize,cmData,false,nil,-1,flags);
                    { If that was a return, add on a linefeed. }
                    if theByte = return then sendByte(linefeed);
                end;
        end;

    procedure sendBS;
        { Send a sequence to erase the previous character. }

        begin
            sendByte(backspace); sendByte(space); sendByte(backspace);
        end;

    begin
        { Assume not termination string, and check the parameter count. }
        lookForTerm := false;
        if paramPtr^.paramCount > 4 then Fail('Invalid parameter count');

        { Make sure the Comm Toolbox is ready and able. }
        CTBReady;
        { And that the connection tool is there. }
        EnsurePresent(connectionTool);
        { And open. }
        EnsureOpen;

        { Get the buffer. }
        theBuf := InputBufferHandle(CMGetUserData(Globals^^.connHand));
        { If there's a termination string already set, get rid of it. }
        if theBuf^^.termString <> nil then
            begin
                DisposHandle(theBuf^^.termString);
                theBuf^^.termString := nil;
                theBuf^^.timeOut := -1;
            end;

        { Get the termination string (if there is one). }
        if ParmPresent(1) then
            begin
                lookForTerm := true;
                HLock(paramPtr^.params[1]);
                termString := paramPtr^.params[1]^;
                termPtr := termString;
            end;
        { Get the time-out. }
        if ParmPresent(2) then timeOut := GetLongParm(2)
        else timeOut := 0;
        stopAt := TickCount + timeOut;
        { Get the column to wrap at. }
        if ParmPresent(3) then wrapCol := GetLongParm(3)
        else wrapCol := 72;
        { Get the character limit. }
        if ParmPresent(4) then theBuf^^.recvLimit := GetLongParm(4)
        else theBuf^^.recvLimit := 50000;

        { Create the answer handle. }
        h := NewHandle(0);
        if h = nil then Fail('Out of memory');

        { Loop until we've got an acceptible result. }
        gotIt := false;
        col := 1;
        plusCount := 0;
        repeat
            { If there's nothing left in the buffer, try to fill it. }
            if theBuf^^.amountLeft = 0 then
                begin
                    { Figure out how much data's available to read. }
                    if CMStatus(Globals^^.connHand,sizes,status) = noErr then
                        begin
                            if BAnd(status,cmStatusOpening+cmStatusListenPend+cmStatusIncomingCallPresent+
                                            cmStatusOpen) = 0 then leave;
                            toRead := min(sizes[cmDataIn],BUFFERSIZE)
                        end
                    else toRead := 0;
                    { Read it in. }
                    if toRead > 0 then toRead := ReadFromConn(@theBuf^^.buffer,toRead);
                    theBuf^^.bufferPtr := @theBuf^^.buffer;
                    theBuf^^.amountLeft := toRead;
                end;
            { Check if there's anything to do, and whether there's any time left. }
            if (theBuf^^.amountLeft <= 0) and ((TickCount - stopAt) > 0) then leave;
            if theBuf^^.amountLeft > 0 then stopAt := TickCount + timeOut;
            { Loop through the new input. }
            gotIt := false;
            while (not gotIt) and (theBuf^^.amountLeft > 0) and (recvMax > 0) do
                begin
                    { Get the next byte. }
                    with theBuf^^ do
                        begin
                            b := BAnd(bufferPtr^,$7F);
                            bufferPtr := Ptr(ord4(bufferPtr)+1);
                            amountLeft := amountLeft-1;
                        end;

                    { Should we auto-wrap? }
                    if (col > wrapCol) and (b <> return) then
                        begin
                            { If this is a space, then auto-wrapping is easy. }
                            if b = space then b := return
                            else
                                begin
                                    { Otherwise, we need to back out to the previous space and put that on the next line. }
                                    l := GetHandleSize(h);
                                    p := Ptr(ord4(h^)+l-1);
                                    l := 1;
                                    while p <> h^ do
                                        begin
                                            if (p^ = space) or (p^ = return) then leave;
                                            p := Ptr(ord4(p)-1);
                                            l := l+1;
                                        end;
                                    if l >= wrapCol then
                                        begin
                                            sendByte(return);
                                            putByte(return);
                                            col := 1;
                                        end
                                    else
                                        begin
                                            HLock(h);
                                            p^ := return;
                                            for l2 := 1 to l do sendBS;
                                            for l2 := 1 to l do
                                                begin
                                                    sendByte(p^);
                                                    p := Ptr(ord4(p)+1);
                                                end;
                                            HUnlock(h);
                                            col := l;
                                        end;
                                end;
                        end;

                    { Control character? }
                    if ((b >= 0) and (b < space) and (b <> return) and (b <> tab)) or (b = delete) then
                        begin
                            { Backspace or delete? }
                            if (b = backspace) or (b = delete) then
                                begin
                                    { Do the backspace. }
                                    if col > 1 then
                                        begin
                                            sendBS;
                                            b := backspaceByte;
                                            col := col-1;
                                            if termPtr <> termString then termPtr := Ptr(ord4(termPtr)-1);
                                        end;
                                end;
                        end
                    else
                        begin
                            { Send and record the byte. }
                            sendByte(b);
                            putByte(b);
                            if b = return then col := 1
                            else col := col+1;

                            { Check for termination string. }
                            if lookForTerm then
                                begin
                                    { Did this one match the next byte in the termination? }
                                    if b = termPtr^ then
                                        begin
                                            termPtr := Ptr(ord4(termPtr)+1);
                                            if termPtr^ = 0 then
                                                begin
                                                    gotIt := true;
                                                    leave;
                                                end;
                                        end
                                    else
                                        begin
                                            { If not, then recalculate where we are in the termination string. }
                                            l := ord4(termPtr)-ord4(termString)-1;
                                            oldTermPtr := termPtr;
                                            termPtr := termString;
                                            while l > 0 do
                                                begin
                                                    p := Ptr(ord4(oldTermPtr)-l);
                                                    l2 := l;
                                                    while l2 > 0 do
                                                        begin
                                                            if p^ <> termPtr^ then leave;
                                                            p := Ptr(ord4(p)+1);
                                                            termPtr := Ptr(ord4(termPtr)+1);
                                                            l2 := l2-1;
                                                        end;
                                                    if (l2 = 0) and (b = termPtr^) then leave;
                                                    l := l-1;
                                                    termPtr := termString;
                                                end;
                                            if b = termPtr^ then termPtr := Ptr(ord4(termPtr)+1)
                                            else termPtr := termString;
                                        end;
                                end;
                        end;
                end
        until gotIt;

        { Unlock the termination string parameter. }
        if lookForTerm then HUnlock(paramPtr^.params[1]);

        { Terminate and strip the handle and return it. }
        StripBytes(h,GetHandleSize(h),true);

        paramPtr^.returnValue := h;
    end;

end.